source("pgload.R")

download financial , check NA value and clear it

getSymbols("2330.tw",auto.assign = F,from = "2000-01-01") %>% 
  na.omit() -> `tw 2330`
## 'getSymbols' currently uses auto.assign=TRUE by default, but will
## use auto.assign=FALSE in 0.5-0. You will still be able to use
## 'loadSymbols' to automatically load data. getOption("getSymbols.env")
## and getOption("getSymbols.auto.assign") will still be checked for
## alternate defaults.
## 
## This message is shown once per session and may be disabled by setting 
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details.
## 
## WARNING: There have been significant changes to Yahoo Finance data.
## Please see the Warning section of '?getSymbols.yahoo' for details.
## 
## This message is shown once per session and may be disabled by setting
## options("getSymbols.yahoo.warning"=FALSE).
## Warning: 2330.tw contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
names(`tw 2330`) <- c("open","high","low","close","volume","adjusted")
`tw 2330` %>% 
    is.na() %>% 
    which((.) == T)
## integer(0)
# `tw 2330`
as_data_frame(`tw 2330`) -> `tw 2330 data frame`
`tw 2330 data frame`$date <- as.Date(row.names(`tw 2330 data frame`))
`tw 2330 data frame` %>% select(date,volume,everything())  %>% 
  filter(volume>0)  -> `tw 2330 data frame`
  # filter(volume>0 |!(is.na(volume))) # volume is not na 包含 0

一星二陽K棒組合可以下列9個條件來刻劃：

1.第t天的收盤價 > 第t天的開盤價 2.第t-2天的收盤價 > 第t-2天的開盤價 3.第t天的開盤價 > 第t-1天的收盤價(1-0.01) 4.第t天的開盤價 < 第t-1天的收盤價(1+0.01)

5.第t-2天的收盤價 > 第t-1天的開盤價*(1-0.01)

6.第t-2天的收盤價 < 第t-1天的開盤價*(1+0.01) 7.第t天的實體K棒長度(漲跌)為1%以上 8.第t-1天的實體K棒長度(漲跌)為0.5%以下 9.第t-2天的實體K棒長度(漲跌)為1%以上

編寫交易條件 并且建搆 進場時間與價格

`tw 2330 data frame` %>% 
  mutate(
      lastC = lag(close,1) , # last day 
      aflastC = lag(close,2) , # after last day
      lastO = lag(open,1) , # last open
      aflastO = lag(open,2), # after last day open 
      kbar = abs( close/open -1),
      lastKbar = lag(kbar,1) ,
      aflastKbar = lag(kbar,2)
    ) %>% 
      filter(
        close > open ,  #1 
        aflastC > aflastO , #2
        open > lastC*0.09 , #3
        open < lastC*1.01 , #4
        aflastC > lastO * 0.09 , #5
        aflastC < lastO * 1.01 , #6
        kbar > 0.01 , #7
        lastKbar < 0.005 , #8
        aflastKbar > 0.01 #9
      ) %>% 
  select(indate = date ,buyprice = close) -> `insite table`

發生收盤價跌破20日移動平均線的位置。收盤價跌破20日移動平均線在程式中的判斷條件為：

t日的收盤價 < t日的20日移動平均線 t-1日的收盤價 > t-1日的20日移動平均線

建搆 出場時間與價格

`tw 2330 data frame` %>%
  mutate(
    sma20 = SMA(close,20) ,
    lastsm20 = sma20 ,
    lastC = lag(close,1)
  ) %>% 
  filter(
    close < sma20 ,
    lastC > lastsm20
  ) %>% 
  select(outdate =date , sellprice = close) -> `outsite table`
`outsite table` %>% 
  head
## # A tibble: 6 x 2
##   outdate    sellprice
##   <date>         <dbl>
## 1 2000-02-21      76.3
## 2 2000-03-02      79.4
## 3 2000-03-22      75.1
## 4 2000-04-13      75.1
## 5 2000-05-02      75.5
## 6 2000-05-03      73.6
`insite table` %>% 
  head
## # A tibble: 6 x 2
##   indate     buyprice
##   <date>        <dbl>
## 1 2000-01-28     79.8
## 2 2001-08-14     48.4
## 3 2001-09-04     46.3
## 4 2001-10-18     41.7
## 5 2002-10-17     33.6
## 6 2002-12-26     35.5
`trade detail table` <- NULL 
for(ix in 1:nrow(`insite table`)){
  indate  <- `insite table`$"indate"[ix]  # 取進場的日期
  `outsite table` %>%  # 把出場的日期向量化
    .$"outdate" -> outdate
  outsite <- which(outdate > indate)[1]  # 把進場日期與 出場日期做比較拿最近時間
  if(length(outsite)>0){  # 假如出場時間存在(用長度判斷)
    # = 0 代表沒有出場時間
    # 合并進場與出場時間
    `trade detail table` = bind_rows(
      `trade detail table` , bind_cols(
        `insite table`[ix,] , `outsite table`[outsite,]  
      )      
    )
  }
    
}

`trade detail table` %>% 
  head
## # A tibble: 6 x 4
##   indate     buyprice outdate    sellprice
##   <date>        <dbl> <date>         <dbl>
## 1 2000-01-28     79.8 2000-02-21      76.3
## 2 2001-08-14     48.4 2001-08-22      43.5
## 3 2001-09-04     46.3 2001-09-06      44.9
## 4 2001-10-18     41.7 2001-12-21      56.1
## 5 2002-10-17     33.6 2002-11-20      35.6
## 6 2002-12-26     35.5 2003-02-06      34.2

一星二陽K棒組合策略績效分析

計算每次交易的報酬率。含交易成本的報酬率算法為：

Ret= Ps???(1???Cs)/Pb???(1+Cb) ???1

其中，Pb和Ps分別為買入價格及賣出價格，Cb和Cs則是買入和賣出交易成本，此處買賣交易成本設定為千分之二。

`buy cost` <- 0.002
`close cost` <- 0.002
`trade detail table` %>% 
  mutate(
   ret = (sellprice*(1-`close cost`) / buyprice*(1+`buy cost`) )-1 ,
   holddays = as.numeric(outdate-indate)
  ) -> `trade detail table`
`trade detail table` %>%  
  head
## # A tibble: 6 x 6
##   indate     buyprice outdate    sellprice     ret holddays
##   <date>        <dbl> <date>         <dbl>   <dbl>    <dbl>
## 1 2000-01-28     79.8 2000-02-21      76.3 -0.0441       24
## 2 2001-08-14     48.4 2001-08-22      43.5 -0.101         8
## 3 2001-09-04     46.3 2001-09-06      44.9 -0.0303        2
## 4 2001-10-18     41.7 2001-12-21      56.1  0.345        64
## 5 2002-10-17     33.6 2002-11-20      35.6  0.0598       34
## 6 2002-12-26     35.5 2003-02-06      34.2 -0.0348       42

策略績效表現衡量的指標，大致上有：

1.平均報酬率 2.交易次數 3.勝率 4.報酬率標準差 5.最大報酬率 6.最小報酬率 7.平均持有日數

`trade detail table` %>% 
  summarise(
    mean = mean(ret),
    num = NROW(indate), # 2.這個策略交易的數量
    `win rate %` = (sum(ret>0)/num)*100,
    sd = sd(ret) ,
    `max rate` = max(ret),
    `min rate` = min(ret),
    `mean holddays` = mean(holddays)
    )
## # A tibble: 1 x 7
##       mean   num `win rate %`     sd `max rate` `min rate` `mean holddays`
##      <dbl> <int>        <dbl>  <dbl>      <dbl>      <dbl>           <dbl>
## 1 0.000371    34         29.4 0.0736      0.345     -0.101            22.5

繪圖前提準備

`tw 2330 data frame` %>% 
  mutate(
    sma5 = SMA(close,5),
    sma20 = SMA(close,20),
    sma60 = SMA(close,60)
  ) -> `tw 2330 data frame`

plotsample <- 1 

`trade detail table` %>% head
## # A tibble: 6 x 6
##   indate     buyprice outdate    sellprice     ret holddays
##   <date>        <dbl> <date>         <dbl>   <dbl>    <dbl>
## 1 2000-01-28     79.8 2000-02-21      76.3 -0.0441       24
## 2 2001-08-14     48.4 2001-08-22      43.5 -0.101         8
## 3 2001-09-04     46.3 2001-09-06      44.9 -0.0303        2
## 4 2001-10-18     41.7 2001-12-21      56.1  0.345        64
## 5 2002-10-17     33.6 2002-11-20      35.6  0.0598       34
## 6 2002-12-26     35.5 2003-02-06      34.2 -0.0348       42
indate <- `trade detail table`$indate[plotsample]
outdate <- `trade detail table`$outdate[plotsample]
matchsite <- which(`tw 2330 data frame`$date == indate)-35
plotStarDate <- `tw 2330 data frame`$date[
  ifelse(
    matchsite<1,
    1,matchsite
    )
  ] # 避免超出範圍 ， 因???-35 如果是負數 ， 那就取date[1]
matchsite <- which(`tw 2330 data frame`$date == outdate) +35
plotEndDate <- `tw 2330 data frame`$date[
  ifelse(
      NROW(`tw 2330 data frame`$date) < matchsite ,
      NROW(`tw 2330 data frame`$date) , matchsite
    )
  ]
`tw 2330 data frame` %>% 
  filter(
    date >= plotStarDate & date <= plotEndDate
  ) -> tw2330

  # 標準進場價位
  rep(NA,length(tw2330$date)) -> tw2330$insite
  tw2330$open[which(tw2330$date==(indate))-1] *0.97 -> tw2330$insite[which(tw2330$date==indate)]  # 進場前一天通知
  
  # 標注出場價位
  rep(NA,length(tw2330$date)) -> tw2330$outsite
  tw2330$close[which(tw2330$date==(outdate))-1] * 1.03 ->   tw2330$outsite[which(tw2330$date==outdate)] # 出場前一天通知
  
  xts(tw2330[,-1],order.by = as.Date(tw2330$date)) -> `tw2330 xts` 
chart_theme() -> mytheme
mytheme$col$dn.col <- "red"
mytheme$col$up.col <- "white"
chart_Series(`tw2330 xts`,theme = mytheme) 

add_Vo()

add_TA(`tw2330 xts`$sma5,col = "black",on=1)

add_TA(`tw2330 xts`$sma20,col="blue",on=1)

add_TA(`tw2330 xts`$sma60,col="pink",on=1)

add_TA(`tw2330 xts`$insite,col="black",on=1,pch=2,cex=5,type="p")

add_TA(`tw2330 xts`$outsite,col="red",on=1,pch=6,cex=5,type="p")

使用 ggplot2 轉成 plotly 觀察每者之間的變化

把程式碼 func 化

`sma Analysis` <- function(plotsample=1,graph="quantmod"){
  
  indate <- `trade detail table`$indate[plotsample]
  outdate <- `trade detail table`$outdate[plotsample]
  matchsite <- which(`tw 2330 data frame`$date == indate)-35
  
  plotStarDate <- `tw 2330 data frame`$date[
    ifelse(
      matchsite<1,
      1,matchsite
      )
    ] # 避免超出範圍 ， 因???-35 如果是負數 ， 那就取date[1]
  matchsite <- which(`tw 2330 data frame`$date == outdate) +35
  plotEndDate <- `tw 2330 data frame`$date[
    ifelse(
        NROW(`tw 2330 data frame`$date) < matchsite ,
        NROW(`tw 2330 data frame`$date) , matchsite
      )
    ]
    
  `tw 2330 data frame` %>% 
  filter(
    date >= plotStarDate & date <= plotEndDate
  ) -> tw2330

  # 標準進場價位
  rep(NA,length(tw2330$date)) -> tw2330$insite
  tw2330$open[which(tw2330$date==(indate))-1] *0.97 -> tw2330$insite[which(tw2330$date==indate)]  # 進場前一天通知
  
  # 標注出場價位
  rep(NA,length(tw2330$date)) -> tw2330$outsite
  tw2330$close[which(tw2330$date==(outdate))-1] * 1.03 ->   tw2330$outsite[which(tw2330$date==outdate)] # 出場前一天通知
  
  xts(tw2330[,-1],order.by = as.Date(tw2330$date)) -> `tw2330 xts` 
  if(graph=="quantmod"){
    chart_theme() -> mytheme
    mytheme$col$dn.col <- "red"
    mytheme$col$up.col <- "white"
    chart_Series(`tw2330 xts`,theme = mytheme) 
    add_Vo()
    add_TA(`tw2330 xts`$sma5,col = "black",on=1)
    add_TA(`tw2330 xts`$sma20,col="blue",on=1)
    add_TA(`tw2330 xts`$sma60,col="pink",on=1)
    add_TA(`tw2330 xts`$insite,col="black",on=1,pch=2,cex=5,type="p")
    add_TA(`tw2330 xts`$outsite,col="red",on=1,pch=6,cex=5,type="p")
  }else{
    tw2330 %>%
      ggplot(aes(date)) + 
        geom_pointrange(aes(y=close,
                            ymin=low,
                            ymax=high,
                            color=-close
                            ),
                        show.legend = F,
                        shape=3
                        ) +
        geom_line(aes(y=sma5),color="red") +
        geom_line(aes(y=sma20),color="orange")+
        geom_line(aes(y=sma60),color="black")+
        labs(title = "morning star") + 
        geom_point(aes(y=insite),color="black",size=3,shape=2) +
        geom_point(aes(y=outsite),color="black",size=3,shape=6) -> p
        ggplotly(p)        
  }
  
}
`sma Analysis`(3)

`sma Analysis`(3,graph = "plotly")

教材來源 : http://cm.nsysu.edu.tw/~msrc/wp/rmarkdown/%E4%B8%80%E6%98%9F%E4%BA%8C%E9%99%BDK%E6%A3%92%E7%B5%84%E5%90%88%E7%A8%8B%E5%BC%8F%E7%AF%84%E4%BE%8B.html